home *** CD-ROM | disk | FTP | other *** search
/ Aminet 25 / Aminet 25 (1998)(GTI - Schatztruhe)[!][Jun 1998].iso / Aminet / dev / e / doomwad.lha / Examples / endoomview.e < prev    next >
Text File  |  1998-03-15  |  4KB  |  133 lines
  1. /*
  2. ** ENDOOM viewer
  3. **
  4. ** A little example for my "doomwad.m" module
  5. **
  6. ** Have fun...
  7. **
  8. */
  9.  
  10. MODULE 'doomwad','exec/memory','dos/dos','intuition/screens','intuition/intuition',
  11.        'graphics/text','diskfont', 'libraries/diskfont'
  12.  
  13. DEF mwh:PTR TO wadhandle, mdb:dirblock, r,c,scr:PTR TO screen, tattr:textattr
  14.  
  15. PROC main()
  16.   DEF x,y,p,fg,bg,fnt
  17.   
  18.   -> Little message
  19.   WriteF('ENDOOM viewer v1.0 ©1998 Peter Gordon\n\nPointless? No, just a programming excersize...\n\n')
  20.   
  21.   -> Details of the IBM style font to use
  22.   tattr.name:='ansi.font'
  23.   tattr.ysize:=8
  24.   tattr.style:=0
  25.   tattr.flags:=0
  26.   
  27.   -> Try to load the font from disk. Doesnt matter if we fail, AmigaOS will
  28.   -> just revert to topaz.
  29.   IF(diskfontbase:=OpenLibrary('diskfont.library',36))
  30.     fnt:=OpenDiskFont(tattr)
  31.     CloseLibrary(diskfontbase)
  32.   ENDIF
  33.   
  34.   -> Open WAD
  35.   IF(mwh:=openwad(arg))
  36.   
  37.     -> Pointless information :)
  38.     WriteF('"\s" is a',arg)
  39.     IF(mwh.iwad) THEN WriteF('n IWAD\n') ELSE WriteF(' PWAD\n')
  40.  
  41.     -> Find the ENDOOM entry
  42.     WriteF('Scanning for ENDOOM lump...')
  43.     r,c:=findentry('ENDOOM',mwh,mdb)
  44.     IF(r)
  45.       
  46.       -> Wahay! We got one!
  47.       WriteF('FOUND!\n')
  48.       
  49.       -> Allocate memory to load the ENDOOM lump into
  50.       IF(c:=NewM(mdb.size,MEMF_ANY))
  51.       
  52.         -> Seek to endoom lump
  53.         Seek(mwh.dosh,mdb.offset,OFFSET_BEGINNING)
  54.         
  55.         -> Read it in
  56.         Read(mwh.dosh,c,mdb.size)
  57.         
  58.         -> Open a 640 x 256 x 16 screen
  59.         IF(scr:=OpenS(640,256,4,$8000,0,[SA_FONT,tattr,SA_SHOWTITLE,FALSE,0,0]))
  60.           
  61.           -> Completely blank it
  62.           Box(0,0,639,255,0)
  63.           
  64.           -> El-Crappo MS-DOG colours :)
  65.           SetColour(scr,0,0,0,0)
  66.           SetColour(scr,1,0,0,170)
  67.           SetColour(scr,2,0,170,0)
  68.           SetColour(scr,3,0,170,170)
  69.           SetColour(scr,4,170,0,0)
  70.           SetColour(scr,5,170,0,170)
  71.           SetColour(scr,6,170,170,0)
  72.           SetColour(scr,7,170,170,170)
  73.           SetColour(scr,8,102,102,102)
  74.           SetColour(scr,9,0,80,255)
  75.           SetColour(scr,10,40,255,40)
  76.           SetColour(scr,11,20,255,255)
  77.           SetColour(scr,12,255,20,20)
  78.           SetColour(scr,13,255,20,255)
  79.           SetColour(scr,14,255,255,0)
  80.           SetColour(scr,15,255,255,255)
  81.           
  82.           -> "p" is the position from the start of the ENDOOM lump
  83.           -> "x" and "y" are the screen positions
  84.           p:=0
  85.           x:=0
  86.           y:=0
  87.           
  88.           -> Loop through the whole endoom lump
  89.           WHILE(p<(mdb.size/2))
  90.           
  91.             -> The ENDOOM lump is basically a dump of the PC text screen
  92.             -> memory, so we have to extract useful values from it.
  93.             -> The foreground colour is stored in the low 4 bits, the
  94.             -> background colour is stored in the next 3 bits, and the
  95.             -> remaining bit is "BLINK", but we're ignoring blink :)
  96.             fg:=(Char(c+(p*2)+1) AND %00001111)
  97.             bg:=Shr((Char(c+(p*2)+1) AND %01110000),4)
  98.             
  99.             -> Set the colour
  100.             Colour(fg,bg)
  101.             
  102.             -> Print the char
  103.             TextF(x*8,y*8+24,'\c',Char(c+(p*2)))
  104.             
  105.             -> Next char in ENDOOM
  106.             INC p
  107.             
  108.             -> Next screen position
  109.             INC x
  110.             IF(x=80)
  111.               x:=0
  112.               INC y
  113.             ENDIF
  114.           ENDWHILE
  115.           
  116.           -> Wait for mouse
  117.           WHILE(Mouse()=0);WaitTOF();ENDWHILE
  118.           
  119.           -> Byee!
  120.           CloseS(scr)
  121.         ENDIF
  122.         Dispose(c)
  123.       ENDIF
  124.     ELSE
  125.       WriteF('No chance :)\n')
  126.     ENDIF
  127.     closewad(mwh)
  128.   ENDIF
  129.   IF(fnt) THEN CloseFont(fnt)
  130. ENDPROC
  131.  
  132.       
  133.